home *** CD-ROM | disk | FTP | other *** search
/ Sound Fx / Sound Fx.iso / Software / UNZIPED / DWSTK / PLAYDWD.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-10  |  7KB  |  263 lines
  1. (******************************************************************************
  2. File:              playdwd.pas
  3. Version:                     2.22
  4. Tab stops:         every 2 columns
  5. Project:           DWD Player
  6. Copyright:         1994-1995 DiamondWare, Ltd.  All rights reserved.
  7. Written:           Keith Weiner & Erik Lorenzen
  8. Pascal Conversion: David A. Johndrow
  9. DPMI Version:      Tom Repstad
  10. Purpose:           Contains simple example code to show how to load/play a
  11.                    .DWD file
  12. History:           94/10/21 KW Started playdwd.c
  13.                    94/11/12 DJ Translated to Pascal
  14.                    95/01/12 EL Finalized
  15.                    95/03/22 EL Finalized for 1.01
  16.                    95/04/11 EL Finalized for 1.02
  17.                                      95/06/06 EL Finalized for 1.03, no changes
  18.                                      95/06/06 EL Finalized for 2.00, no changes
  19.                    95/09/11 TR Protected Mode Version
  20.                                      95/10/16 EL Finalized for 2.10, fixed bug in Exist (typo)
  21.                                      95/10/24 EL Changed volumes to 95%, general cleanup
  22.                                      95/10/24 EL Finalized for 2.20
  23.                                      95/12/07 EL Finalized for 2.21, no changes
  24.                                      96/10/10 EL Finalized for 2.22, no changes
  25.  
  26. Notes
  27. -----
  28. This code isn't really robust when it comes to standard error checking
  29. and particularly recovery, software engineering technique, etc.  A buffer
  30. is statically allocated.  A better technique would be to use fstat() or stat()
  31. to determine the file's size then malloc(size).  The STK will handle songs
  32. larger than 64K (but not digitized sounds).  Obviously, you'd need to fread()
  33. such a file in chunks, or write some sort of hfread() (huge fread).  Also,
  34. exitting and cleanup is not handled robustly in this code.  The code below can
  35. only be validated by extremely careful scrutiny to make sure each case is
  36. handled properly.
  37.  
  38. But all such code would make this example file less clear; its purpose was
  39. to illustrate how to call the STK, not how to write QA-proof software.
  40. ******************************************************************************)
  41.  
  42.  
  43.  
  44. program playdwd;
  45.  
  46. {$IFDEF DPMI}
  47.     uses crt, err, mem, dws, winapi;
  48. {$ELSE}
  49.     uses crt, err, mem, dws;
  50. {$ENDIF}
  51.  
  52.  
  53. var
  54.     ExitSave:     pointer;
  55.  
  56.     sound:            dws_ADDRESS;
  57.     soundsize:    longint;
  58.  
  59.   dov:        dws_DOPTR;
  60.   dres:       dws_DRPTR;
  61.   ideal:      dws_IDPTR;
  62.     dplay:            dws_DPPTR;
  63.  
  64.   fp:         file;
  65.   result:     word;
  66.  
  67.  
  68. function Exist(filename: string): boolean;
  69. var
  70.     fp: file;
  71.  
  72. begin
  73.     assign(fp, filename);
  74.   {$I- }
  75.     reset(fp);
  76.     close(fp);
  77.   {$I+ }
  78.  
  79.   Exist := (IOResult = 0);
  80. end;
  81.  
  82.  
  83. procedure ExitPlay; far;
  84.  
  85. label TRYTOKILLAGAIN;
  86.  
  87. begin
  88.   ExitProc := ExitSave;
  89.  
  90. TRYTOKILLAGAIN:
  91.  
  92.   if (dws_Kill <> 1) then
  93.     begin
  94.     (*
  95.      . If an error occurs here, it's either dws_Kill_CANTUNHOOKISR
  96.      . or dws_NOTINITTED.  If it's dws_Kill_CANTUNHOOKISR the user
  97.      . must remove his tsr, and dws_Kill must be called again.  If it's
  98.      . dws_NOTINITTED, there's nothing to worry about at this point.
  99.     *)
  100.     err_Display;
  101.  
  102.     if (dws_ErrNo = dws_Kill_CANTUNHOOKISR) then
  103.         begin
  104.       goto TryToKillAgain;
  105.         end;
  106.     end;
  107.  
  108.     {$IFDEF DPMI}
  109.     if (sound.ptr <> nil) then
  110.     {$ELSE}
  111.     if (sound <> nil) then
  112.     {$ENDIF}
  113.     begin
  114.         mem_FreeDOS(sound, soundsize);
  115.     end;
  116.  
  117.   dispose(dplay);
  118.   dispose(ideal);
  119.   dispose(dres);
  120.   dispose(dov);
  121. end;
  122.  
  123.  
  124.  
  125. begin
  126.   ExitSave := ExitProc;
  127.   ExitProc := @ExitPlay;
  128.  
  129.   writeln;
  130.     writeln('PLAYDWD 2.22 is Copyright 1994-95, DiamondWare, Ltd.');
  131.   writeln('All rights reserved.');
  132.   writeln;
  133.   writeln;
  134.  
  135.   new(dov);
  136.   new(dres);
  137.   new(ideal);
  138.   new(dplay);
  139.  
  140.     {$IFDEF DPMI}
  141.     sound.ptr := nil;
  142.     {$ELSE}
  143.     sound := nil;
  144.     {$ENDIF}
  145.  
  146.  
  147.   if (ParamCount = 0) then
  148.     begin
  149.     writeln('Usage PLAYDWD <dwd-file>');
  150.     halt(65535);
  151.     end;
  152.  
  153.   if Exist(ParamStr(1)) then
  154.     begin
  155.         assign(fp, ParamStr(1));
  156.         reset(fp,1);
  157.     soundsize := filesize(fp);
  158.  
  159.     (* Please note we don't check to see if we get the memory we need. *)
  160.         mem_GetDOS(sound, soundsize);
  161.  
  162.         {$IFDEF DPMI}
  163.         blockread(fp, sound.ptr^, soundsize);
  164.         {$ELSE}
  165.         blockread(fp, sound^, soundsize);
  166.         {$ENDIF}
  167.  
  168.  
  169.         close(fp);
  170.   end
  171.   else
  172.     begin
  173.     writeln('Unable to open '+ParamStr(1));
  174.     halt(65535);
  175.     end;
  176.  
  177.   (*
  178.    . We need to set every field to -1 in dws_DETECTOVERRIDES record; this
  179.    . tells the STK to autodetect everything.  Any other value
  180.    . overrides the autodetect routine, and will be accepted on
  181.    . faith, though the STK will verify it if possible.
  182.   *)
  183.   dov^.baseport := 65535;
  184.   dov^.digdma   := 65535;
  185.   dov^.digirq   := 65535;
  186.  
  187.   if (dws_DetectHardWare(dov, dres) = 0) then
  188.     begin
  189.     err_Display;
  190.     halt(65535);
  191.     end;
  192.  
  193.   if ((dres^.capability and dws_capability_DIG) <> dws_capability_DIG) then
  194.     begin
  195.     if ((dres^.baseport <> 904) and (dres^.baseport <> 65535)) then
  196.         begin
  197.       writeln('The sound hardware supports digitized sound playback,');
  198.       writeln('but we could not find the DMA channel and/or IRQ level.');
  199.     end
  200.     else
  201.         begin
  202.       writeln('Support for digitized playback not found.');
  203.         end;
  204.  
  205.     halt(65535);
  206.     end;
  207.  
  208.  
  209.   (*
  210.    . The "ideal" record tells the STK how you'd like it to initialize the
  211.    . sound hardware.  In all cases, if the hardware won't support your
  212.    . request, the STK will go as close as possible.  For example, not all
  213.    . sound boards will support al sampling rates (some only support 5 or
  214.    . 6 discrete rates).
  215.   *)
  216.   ideal^.musictyp   := 0;     (*0=No music, 1=OPL2*)
  217.   ideal^.digtyp     := 8;     (*0=No Dig, 8=8bit*)
  218.   ideal^.dignvoices := 1;     (*number of voices (up to 16)*)
  219.   ideal^.dignchan   := 1;     (*1=mono*)
  220.  
  221.     (*Set ideal^.digrate, in Hz*)
  222.   if (dws_DGetRateFromDWD(sound, @ideal^.digrate) = 0) then
  223.     begin
  224.     err_Display;
  225.     halt(65535);
  226.     end;
  227.  
  228.   if (dws_Init(dres, ideal) = 0) then
  229.     begin
  230.     err_Display;
  231.     halt(65535);
  232.     end;
  233.  
  234.     (* Set master volume to about 95% max *)
  235.     if (dws_XMaster(242) = 0) then
  236.     begin
  237.     err_Display;
  238.     end;
  239.  
  240.   dplay^.snd      := sound;
  241.   dplay^.count    := 1;       (* 0=infinite loop, 1-N num times to play sound *)
  242.   dplay^.priority := 1000;
  243.   dplay^.presnd   := 0;
  244.  
  245.   if (dws_DPlay(dplay) = 0) then
  246.     begin
  247.     err_Display;
  248.     halt(65535);
  249.     end;
  250.  
  251.   repeat
  252.     begin
  253.     if(dws_DSoundStatus(dplay^.soundnum, @result) = 0) then
  254.         begin
  255.       err_Display;
  256.       halt(65535);
  257.         end;
  258.     end;
  259.   until (result = 0) or (keypressed);
  260.  
  261.     halt(0);
  262. end.
  263.